#!/usr/bin/env gosh
(use srfi-1)
(use util.match)
(use file.util)
(use fuse)

(define (read-scm path)
  (call-with-input-file path
    (lambda (in)
      (port->sexp-list (open-coding-aware-port in)))))

(define (fstree->stree path)
  (define (selector e)
    (and (file-exists? e)
         (eq? (file-type e :follow-link? #f) 'directory)))
  (define (rec path)
    ;;Remove the identifer such as 1012% from filenames /1012%lambda/1013%x/...
    (receive (dir fn ext) (decompose-path (regexp-replace-all #/\/\d{4,4}%/ path "/"))
      ;;Read the filename as Scheme symbol.
      (let1 sym (call-with-input-string (if ext (string-append fn "." ext) fn) read)
        (if (selector path)
          (let1 dirs (map rec (directory-list path :add-path? #t :children? #t))
            ;; deal with a reserved filename "LIST" as the null list.
            (if (string=? fn "LIST")
              dirs
              (cons sym dirs)))
          (if (string=? fn "NULL")
            '()
            sym)))))
  ;; This "cdr" extract s-tree.
  (cdr (rec path)))

(define (stree->fstree path tree)
  (define (naming count x)
    (format #f "~4,'0d%~s" count x))
  (define count 1000)
  (define (loop path tree)
    (match tree
           (()             (touch-file (build-path path (naming count 'NULL)))
                           (inc! count 5))
           ((()      . xs)  (let1 new-path (build-path path (naming count 'LIST))
                             (make-directory* new-path)
                             (inc! count 5)
                             (touch-file (build-path new-path (naming count 'NULL)))
                             (inc! count 5)
                             (for-each (cut loop new-path <>) xs)))
           (((a . b) . xs) (let1 new-path (build-path path (naming count 'LIST))
                             (make-directory* new-path)
                             (inc! count 5)
                             (for-each (cut loop new-path <>) tree)))
           ((x       . xs) (let1 new-path (build-path path (naming count x))
                             (make-directory* new-path)
                             (inc! count 5)
                             (for-each (cut loop new-path <>) xs)))
           (x              (touch-file (build-path path (naming count x)))
                           (inc! count 5))))
  (for-each (cut loop path <>) tree)
  count)

;;(define problem (read-scm "./test.scm"))
;;(stree->fstree (build-path (temporary-directory) "test") problem)
;;(fstree->stree (build-path (temporary-directory) "test"))

;; define your favorite path for the backend.
(define rootdir "/home/teruaki/garakuta-okiba/fuse/root")

(define (root path)
  (build-path rootdir
              (if (absolute-path? path)
                (string-scan path "/" 'after)
                path)))

(define (first-dir path)  
  (first (string-split (if (absolute-path? path)
                         (string-scan path "/" 'after)
                         path)
                       "/")))

(define (save-fstree-as-stree path)
  ;; unless the file at top-level like "/foobar"
  (when (> (length (string-split path "/")) 2)
    (let1 f (root (first-dir path))
      (call-with-output-file (string-append f ".scm")
        (lambda (out)
          (for-each (lambda (x)
                      (write x out)
                      (newline out))
                    (fstree->stree f)))))))
        

(define (save-stree-as-fstree path)
  ;; when the file at top-level like "/a.scm"
  (rxmatch-if (#/^\/([^\/]+)\.scm$/ path)
      (#f dir)
      (begin (remove-files (root dir))
             (stree->fstree (root dir) (read-scm (root path))))
      #f))

(define (sexpfs-lstat path)
  (sys-lstat (root path)))

(define (sexpfs-access path mask)
  (sys-access (root path) mask))

(define (sexpfs-mkdir path mode)
  (begin0
    (sys-mkdir (root path) mode)
    (save-fstree-as-stree path)))

(define (sexpfs-unlink path)
  (begin0
    (sys-unlink (root path))
    (save-fstree-as-stree path)))

(define (sexpfs-rmdir path)
  (begin0
    (sys-rmdir (root path))
    (save-fstree-as-stree path)))

(define (sexpfs-rename old new)
  (begin0
    (sys-rename (root old) (root new))
    (save-fstree-as-stree new)))

(define (sexpfs-chmod path mode)
  (sys-chmod (root path) mode))

(define (sexpfs-chown path owner-id group-id)
  (sys-chown (root path) owner-id group-id))

(define (sexpfs-truncate path length)
  (sys-truncate (root path) length))

(define (sexpfs-utime path atime mtime)
  (sys-utime (root path) atime mtime))

(define (sexpfs-statfs path)
  (save-stree-as-fstree path)
  (sys-statvfs (root path)))

(define (sexpfs-readdir path fuse-info)
  (sys-readdir (root path)))

(define (sexpfs-mknod path mode rdev)
  (define st (make <sys-stat>))
  (sys-stat->mode-set! st mode)
  (case (slot-ref st 'type)
    ('regular
     (begin0       
       (close-output-port (open-output-file (root path)))
       (save-fstree-as-stree path)))
    ('fifo
     (sys-mkfifo (root path) mode))
    (else
     ;;please use the "mknod" external command.
     (error <system-error> :errno ENOENT))))

(define (sexpfs-open path file-info)
  (begin0       
    (close-input-port (open-input-file (root path)))
    (save-fstree-as-stree path)))

(define (sexpfs-read path outp size offset fuse-info)
  (call-with-input-file (root path) (lambda (in)
                                      (port-seek in offset)
                                      (copy-port in outp))))

(define (sexpfs-write path inp size offset fuse-info)
  (call-with-output-file (root path) (lambda (out)
                                       (port-seek out offset)
                                       (copy-port inp out))
                         :if-exists :overwrite))
(define (main args)
  (start-fuse "/tmp/fs"
              :getattr  sexpfs-lstat
              :access   sexpfs-access
              :mkdir    sexpfs-mkdir
              :unlink   sexpfs-unlink
              :rmdir    sexpfs-rmdir
              :rename   sexpfs-rename
              :chmod    sexpfs-chmod
              :chown    sexpfs-chown
              :truncate sexpfs-truncate
              :utimens  sexpfs-utime
              :statfs   sexpfs-statfs
              :readdir  sexpfs-readdir
              :mknod    sexpfs-mknod
              :open     sexpfs-open
              :read     sexpfs-read
              :write    sexpfs-write))

